home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / gsdrw3.for < prev    next >
Text File  |  1991-05-01  |  2KB  |  88 lines
  1.         SUBROUTINE GSDRW3(X0,Y0,X1,Y1)
  2.         IMPLICIT NONE
  3. C
  4. C        DRAW A LINE FROM (X0,Y0) TO (X1,Y1) IN ABSOLUTE COORDINATES.
  5. C        ASSUMES THAT CLIPPING HAS ALREADY BEEN DONE.   TO SUPPRESS UNNECESSA
  6. C        "MOVES", THIS IS THE ONLY ROUTINE THAT SHOULD CALL GSDRVR(3,,,).
  7. C        THE LINE IS DRAWN IN THE CURRENT LINE TYPE.   THIS ROUTINE DOES NOT
  8. C        SET THE ABSOLUTE POSITION (XAPOS,YAPOS).   IT IS UP TO THE CALLER TO
  9. C        DO SO IF NECESSARY.
  10. C
  11.         INCLUDE DIGLIB$KOM:GCLTYP.PRM
  12.  
  13.         REAL*4 X0,Y0,X1,Y1,DX,DY,DL,S
  14.     INTEGER*1 IAND, IVAL
  15.     EXTERNAL IAND
  16. C
  17. D    WRITE(9,2134)X0,Y0,X1,Y1
  18. D2134    FORMAT("GSDRW3",4(F10.3,1X))
  19.  
  20.         IF (ILNTYP .GT. 1) GO TO 50
  21.         IF (.NOT. LPOSND) CALL GSDRVR(3,X0,Y0)
  22.         GO TO 220
  23. C
  24. C       SEGMENT LINE TO MAKE CURRENT LINE TYPE
  25. C
  26. 50      CONTINUE
  27. D    WRITE(9,2137)LINILT
  28. D2137    FORMAT("LINILT",L6)
  29.         IF (.NOT. LINILT) GO TO 100
  30.         INXTL = 1
  31.         DLEFT = DIST(1,ILNTYP-1)
  32.         LINILT = .FALSE.
  33. D    WRITE(9,2135)LINILT,INXTL,DLEFT,ILNTYP
  34. D2135    FORMAT("LINILT,INXTL,DLEFT,ILNTYP",I4,1X,L6,1X,F10.3,1X,L6)
  35.         IF (.NOT. LPOSND) CALL GSDRVR(3,X0,Y0)
  36.  
  37. 100     CONTINUE
  38.     DX = X1-X0
  39.         DY = Y1-Y0
  40.         DL = SQRT(DX**2+DY**2)
  41. D    WRITE(9,2136)DX,DY
  42. D2136    FORMAT(1X,"DX DY",2(F10.3,1X))
  43. C
  44. C       SEE IF THIS SEGMENT IS SHORTER THAT DIST. LEFT ON LINE TYPE
  45. C
  46.         IF (DL .LE. DLEFT) GO TO 200
  47. C
  48. C       SEGMENT IS LONGER, SO ADVANCE TO LINE TYPE BREAK
  49. C
  50.         S = DLEFT/DL
  51.         X0 = S*DX+X0
  52.         Y0 = S*DY+Y0
  53. C
  54. C       SEE IF THIS PART OF THE LINE TYPE IS DRAWN OR SKIPPED
  55. C
  56. C    IVAL = IAND(INXTL,1)
  57.     IVAL = INXTL .AND. 1
  58. D    WRITE(9,9898)IVAL,IVAL,INXTL,INXTL
  59. D9898    FORMAT("IVAL IVAL INXTL INXTL",2(L6,I4));
  60.         IF (IVAL .NE. 0) GO TO 120
  61.                 CALL GSDRVR(3,X0,Y0)
  62.                 GO TO 140
  63. 120         CONTINUE
  64.                 CALL GSDRVR(4,X0,Y0)
  65. 140     CONTINUE
  66. C
  67. C       NOW GO TO NEXT PORTION OF LINE TYPE
  68. C
  69.         INXTL = INXTL + 1
  70.         IF (INXTL .GT. 4) INXTL = 1
  71.         DLEFT = DIST(INXTL,ILNTYP-1)
  72.         GO TO 100
  73. C
  74. C       DRAW LAST OF LINE IF DRAWN
  75. C
  76. 200     CONTINUE
  77.         DLEFT = DLEFT - DL
  78.         IF (IAND(INXTL,1) .NE. 0) GO TO 220
  79.                 LPOSND = .FALSE.
  80.                 GO TO 240
  81. 220         CONTINUE
  82.                 CALL GSDRVR(4,X1,Y1)
  83.                 LPOSND = .TRUE.
  84. 240     CONTINUE
  85.         RETURN
  86.         END
  87.  
  88.